home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / amigaunits / icon.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  6.8 KB  |  301 lines
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.  
  4.     A file in Amiga system run time library.
  5.     Copyright (c) 1998-2000 by Nils Sjoholm
  6.     member of the Amiga RTL development team.
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16. {
  17.     History:
  18.     Added overlay functions for Pchar->Strings, functions
  19.     and procedures.
  20.  
  21.     14 Jul 2000.
  22.     nils.sjoholm@mailbox.swipnet.se
  23. }
  24. unit icon;
  25.  
  26. INTERFACE
  27.  
  28. {$I amigaoverlays.inc}
  29.  
  30. uses exec, workbench;
  31.  
  32.  
  33. Const
  34.  
  35.     ICONNAME    : PChar = 'icon.library';
  36.  
  37. VAR IconBase : pLibrary;
  38.  
  39. FUNCTION AddFreeList(freelist : pFreeList; mem : POINTER; size : ULONG) : BOOLEAN;
  40. FUNCTION BumpRevision(newname : pCHAR; oldname : pCHAR) : pCHAR;
  41. FUNCTION DeleteDiskObject(name : pCHAR) : BOOLEAN;
  42. FUNCTION FindToolType(toolTypeArray : POINTER; typeName : pCHAR) : pCHAR;
  43. PROCEDURE FreeDiskObject(diskobj : pDiskObject);
  44. PROCEDURE FreeFreeList(freelist : pFreeList);
  45. FUNCTION GetDefDiskObject(typ : LONGINT) : pDiskObject;
  46. FUNCTION GetDiskObject(name : pCHAR) : pDiskObject;
  47. FUNCTION GetDiskObjectNew(name : pCHAR) : pDiskObject;
  48. FUNCTION MatchToolValue(typeString : pCHAR; value : pCHAR) : BOOLEAN;
  49. FUNCTION PutDefDiskObject(diskObject : pDiskObject) : BOOLEAN;
  50. FUNCTION PutDiskObject(name : pCHAR; diskobj : pDiskObject) : BOOLEAN;
  51.  
  52. {$ifdef amiga_overlays}
  53.  
  54. FUNCTION BumpRevision(newname : string; oldname : pCHAR) : pCHAR;
  55. FUNCTION BumpRevision(newname : pCHar; oldname : string) : pCHAR;
  56. FUNCTION BumpRevision(newname : string; oldname : string) : pCHAR;
  57. FUNCTION DeleteDiskObject(name : string) : BOOLEAN;
  58. FUNCTION FindToolType(toolTypeArray : POINTER; typeName : string) : pCHAR;
  59. FUNCTION GetDiskObject(name : string) : pDiskObject;
  60. FUNCTION GetDiskObjectNew(name : string) : pDiskObject;
  61. FUNCTION MatchToolValue(typeString : string; value : pCHAR) : BOOLEAN;
  62. FUNCTION MatchToolValue(typeString : pCHAR; value : string) : BOOLEAN;
  63. FUNCTION MatchToolValue(typeString : string; value : string) : BOOLEAN;
  64. FUNCTION PutDiskObject(name : string; diskobj : pDiskObject) : BOOLEAN;
  65.  
  66. {$endif}
  67.  
  68. IMPLEMENTATION
  69.  
  70. {$ifdef amiga_overlays}
  71. uses pastoc;
  72. {$endif}
  73.  
  74. FUNCTION AddFreeList(freelist : pFreeList; mem : POINTER; size : ULONG) : BOOLEAN;
  75. BEGIN
  76.   ASM
  77.     MOVE.L  A6,-(A7)
  78.     MOVEA.L freelist,A0
  79.     MOVEA.L mem,A1
  80.     MOVEA.L size,A2
  81.     MOVEA.L IconBase,A6
  82.     JSR -072(A6)
  83.     MOVEA.L (A7)+,A6
  84.     TST.W   D0
  85.     BEQ.B   @end
  86.     MOVEQ   #1,D0
  87.   @end: MOVE.B  D0,@RESULT
  88.   END;
  89. END;
  90.  
  91. FUNCTION BumpRevision(newname : pCHAR; oldname : pCHAR) : pCHAR;
  92. BEGIN
  93.   ASM
  94.     MOVE.L  A6,-(A7)
  95.     MOVEA.L newname,A0
  96.     MOVEA.L oldname,A1
  97.     MOVEA.L IconBase,A6
  98.     JSR -108(A6)
  99.     MOVEA.L (A7)+,A6
  100.     MOVE.L  D0,@RESULT
  101.   END;
  102. END;
  103.  
  104. FUNCTION DeleteDiskObject(name : pCHAR) : BOOLEAN;
  105. BEGIN
  106.   ASM
  107.     MOVE.L  A6,-(A7)
  108.     MOVEA.L name,A0
  109.     MOVEA.L IconBase,A6
  110.     JSR -138(A6)
  111.     MOVEA.L (A7)+,A6
  112.     TST.W   D0
  113.     BEQ.B   @end
  114.     MOVEQ   #1,D0
  115.   @end: MOVE.B  D0,@RESULT
  116.   END;
  117. END;
  118.  
  119. FUNCTION FindToolType(toolTypeArray : POINTER; typeName : pCHAR) : pCHAR;
  120. BEGIN
  121.   ASM
  122.     MOVE.L  A6,-(A7)
  123.     MOVEA.L toolTypeArray,A0
  124.     MOVEA.L typeName,A1
  125.     MOVEA.L IconBase,A6
  126.     JSR -096(A6)
  127.     MOVEA.L (A7)+,A6
  128.     MOVE.L  D0,@RESULT
  129.   END;
  130. END;
  131.  
  132. PROCEDURE FreeDiskObject(diskobj : pDiskObject);
  133. BEGIN
  134.   ASM
  135.     MOVE.L  A6,-(A7)
  136.     MOVEA.L diskobj,A0
  137.     MOVEA.L IconBase,A6
  138.     JSR -090(A6)
  139.     MOVEA.L (A7)+,A6
  140.   END;
  141. END;
  142.  
  143. PROCEDURE FreeFreeList(freelist : pFreeList);
  144. BEGIN
  145.   ASM
  146.     MOVE.L  A6,-(A7)
  147.     MOVEA.L freelist,A0
  148.     MOVEA.L IconBase,A6
  149.     JSR -054(A6)
  150.     MOVEA.L (A7)+,A6
  151.   END;
  152. END;
  153.  
  154. FUNCTION GetDefDiskObject(typ : LONGINT) : pDiskObject;
  155. BEGIN
  156.   ASM
  157.     MOVE.L  A6,-(A7)
  158.     MOVE.L  typ,D0
  159.     MOVEA.L IconBase,A6
  160.     JSR -120(A6)
  161.     MOVEA.L (A7)+,A6
  162.     MOVE.L  D0,@RESULT
  163.   END;
  164. END;
  165.  
  166. FUNCTION GetDiskObject(name : pCHAR) : pDiskObject;
  167. BEGIN
  168.   ASM
  169.     MOVE.L  A6,-(A7)
  170.     MOVEA.L name,A0
  171.     MOVEA.L IconBase,A6
  172.     JSR -078(A6)
  173.     MOVEA.L (A7)+,A6
  174.     MOVE.L  D0,@RESULT
  175.   END;
  176. END;
  177.  
  178. FUNCTION GetDiskObjectNew(name : pCHAR) : pDiskObject;
  179. BEGIN
  180.   ASM
  181.     MOVE.L  A6,-(A7)
  182.     MOVEA.L name,A0
  183.     MOVEA.L IconBase,A6
  184.     JSR -132(A6)
  185.     MOVEA.L (A7)+,A6
  186.     MOVE.L  D0,@RESULT
  187.   END;
  188. END;
  189.  
  190. FUNCTION MatchToolValue(typeString : pCHAR; value : pCHAR) : BOOLEAN;
  191. BEGIN
  192.   ASM
  193.     MOVE.L  A6,-(A7)
  194.     MOVEA.L typeString,A0
  195.     MOVEA.L value,A1
  196.     MOVEA.L IconBase,A6
  197.     JSR -102(A6)
  198.     MOVEA.L (A7)+,A6
  199.     TST.W   D0
  200.     BEQ.B   @end
  201.     MOVEQ   #1,D0
  202.   @end: MOVE.B  D0,@RESULT
  203.   END;
  204. END;
  205.  
  206. FUNCTION PutDefDiskObject(diskObject : pDiskObject) : BOOLEAN;
  207. BEGIN
  208.   ASM
  209.     MOVE.L  A6,-(A7)
  210.     MOVEA.L diskObject,A0
  211.     MOVEA.L IconBase,A6
  212.     JSR -126(A6)
  213.     MOVEA.L (A7)+,A6
  214.     TST.W   D0
  215.     BEQ.B   @end
  216.     MOVEQ   #1,D0
  217.   @end: MOVE.B  D0,@RESULT
  218.   END;
  219. END;
  220.  
  221. FUNCTION PutDiskObject(name : pCHAR; diskobj : pDiskObject) : BOOLEAN;
  222. BEGIN
  223.   ASM
  224.     MOVE.L  A6,-(A7)
  225.     MOVEA.L name,A0
  226.     MOVEA.L diskobj,A1
  227.     MOVEA.L IconBase,A6
  228.     JSR -084(A6)
  229.     MOVEA.L (A7)+,A6
  230.     TST.W   D0
  231.     BEQ.B   @end
  232.     MOVEQ   #1,D0
  233.   @end: MOVE.B  D0,@RESULT
  234.   END;
  235. END;
  236.  
  237. {$ifdef amiga_overlays}
  238.  
  239. FUNCTION BumpRevision(newname : string; oldname : pCHAR) : pCHAR;
  240. begin
  241.       BumpRevision := BumpRevision(pas2c(newname),oldname);
  242. end;
  243.  
  244. FUNCTION BumpRevision(newname : pCHar; oldname : string) : pCHAR;
  245. begin
  246.       BumpRevision := BumpRevision(newname,pas2c(oldname));
  247. end;
  248.  
  249. FUNCTION BumpRevision(newname : string; oldname : string) : pCHAR;
  250. begin
  251.       BumpRevision := BumpRevision(pas2c(newname),pas2c(oldname));
  252. end;
  253.  
  254. FUNCTION DeleteDiskObject(name : string) : BOOLEAN;
  255. begin
  256.       DeleteDiskObject := DeleteDiskObject(pas2c(name));
  257. end;
  258.  
  259. FUNCTION FindToolType(toolTypeArray : POINTER; typeName : string) : pCHAR;
  260. begin
  261.       FindToolType := FindToolType(toolTypeArray,pas2c(typeName));
  262. end;
  263.  
  264. FUNCTION GetDiskObject(name : string) : pDiskObject;
  265. begin
  266.       GetDiskObject := GetDiskObject(pas2c(name));
  267. end;
  268.  
  269. FUNCTION GetDiskObjectNew(name : string) : pDiskObject;
  270. begin
  271.       GetDiskObjectNew := GetDiskObjectNew(pas2c(name)); 
  272. end;
  273.  
  274. FUNCTION MatchToolValue(typeString : string; value : pCHAR) : BOOLEAN;
  275. begin
  276.        MatchToolValue := MatchToolValue(pas2c(typeString),value);
  277. end;
  278.  
  279. FUNCTION MatchToolValue(typeString : pCHAR; value : string) : BOOLEAN;
  280. begin
  281.        MatchToolValue := MatchToolValue(typeString,pas2c(value));
  282. end;
  283.  
  284. FUNCTION MatchToolValue(typeString : string; value : string) : BOOLEAN;
  285. begin
  286.        MatchToolValue := MatchToolValue(pas2c(typeString),pas2c(value));
  287. end;
  288.  
  289. FUNCTION PutDiskObject(name : string; diskobj : pDiskObject) : BOOLEAN;
  290. begin
  291.        PutDiskObject := PutDiskObject(pas2c(name),diskobj);
  292. end;
  293.  
  294.  
  295. {$endif}
  296.  
  297. END. (* UNIT ICON *)
  298.  
  299.  
  300.  
  301.